home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 10
/
FM Towns Free Software Collection 10.iso
/
ms_dos
/
tool
/
happy03
/
calendar.pas
next >
Wrap
Pascal/Delphi Source File
|
1994-11-16
|
6KB
|
151 lines
{*********************************************************************
* **** カレンダー (HAPPy Version 0.3添付版) **** *
* *
* HAPPyのサンプルプログラム *
* (作者 浅野比富美 Public Domain Software) *
*********************************************************************}
(*
inputから、表示させたい年と月を入力すると、
その月の前後1ケ月ずつ、合計3ケ月にわたってカレンダーを
outputに出力します
*)
program Calendar(input,output) ;
type
PrintRange = (before,now,after) ; { before:前月 now:今月 after:来月}
YoubiType = 0..6 ; { 日曜日=0 土曜日=6 }
var
Nissu : array[1..12] of 1..31 ; { 月の日数を格納 }
Year : array[PrintRange] of integer ; { 表示する年を格納 }
Month : array[PrintRange] of integer ; { 表示する月を格納 }
FirstYoubi : array[PrintRange] of YoubiType ; { 1日の曜日 }
(***************************************)
(* 初期設定 (各月の日数を設定) *)
(* とりあえず 2月は28日としておく *)
(***************************************)
procedure init ;
begin
Nissu[ 1{月}] := 31{日} ; Nissu[ 2{月}] := 28{日} ; Nissu[ 3{月}] := 31{日} ;
Nissu[ 4{月}] := 30{日} ; Nissu[ 5{月}] := 31{日} ; Nissu[ 6{月}] := 30{日} ;
Nissu[ 7{月}] := 31{日} ; Nissu[ 8{月}] := 31{日} ; Nissu[ 9{月}] := 30{日} ;
Nissu[10{月}] := 31{日} ; Nissu[11{月}] := 30{日} ; Nissu[12{月}] := 31{日}
end {init} ;
(***************************************)
(* y年m月d日の曜日を算出する関数 *)
(* この関数で使っている計算式の *)
(* 意味はよくわかりませんが、 *)
(* 汎用関数として使えると思います *)
(***************************************)
function Youbi(y{年},m{月},d{日}:integer) : YoubiType ;
var m1,y1 : integer;
begin
if m >= 3 then
begin m1 := m - 2 ; y1 := y end
else
begin m1 := m + 10 ; y1 := y - 1 end ;
Youbi := (y1 + y1 div 4 - y1 div 100 + y1 div 400
+ trunc(2.6*m1 - 0.19) + d ) mod 7
end {Youbi} ;
(***************************************)
(* year年が閏年の時、真を返す関数 *)
(* 4年に一度だが、、100年に一度閏年で *)
(* なく、400年に一度閏年になります *)
(***************************************)
function Uruu(year:integer) : Boolean ;
begin
Uruu := (year mod 4 = 0) and (year mod 100 <> 0) or (year mod 400 = 0)
end {Uruu} ;
(***************************************)
(* カレンダーの表示処理 *)
(***************************************)
procedure Print ;
var Day : array[PrintRange] of integer ; { 表示する日 }
Finish : array[PrintRange] of Boolean ; { 各月の表示が終わったら真 }
youbi : YoubiType ;
n : PrintRange ;
begin
for n := before to after do { 初期設定 }
begin
Finish[n] := false ;
Day [n] := 1{日}
end ;
writeln ; { カレンダーの表題 }
for n := before to after do
write('****':9,Year[n]:5,'年',Month[n]:2,'月 ****') ;
writeln ;
for n := before to after do
write('日 月 火 水 木 金 土':25) ;
writeln ;
repeat
for n := before to after do { 前月 今月 来月の 1行分 }
begin
write(' ':4) ; { 次の月のカラムまで進める }
for youbi := 0{日曜} to 6{土曜} do { 各月の1週間分 }
begin
if (Day[n] = 1{日}) and (youbi < FirstYoubi[n]) or Finish[n]
then write(' ':3)
else { 表示していない日の時 }
begin
write(Day[n]:3) ;
Day[n] := Day[n] + 1{日} ;
Finish[n] := Day[n] > Nissu[Month[n]] { その月の終わりの判定 }
end
end {for youbi}
end {for n} ;
writeln
until Finish[before] and Finish[now] and Finish[after]
end {Print} ;
(***************************************)
(* メイン処理 *)
(***************************************)
begin {main}
init ; { 初期設定 }
repeat { 表示したい年を入力 }
write('何年?(西暦2年~9998年) ') ;
readln(Year[now])
until (2{年} <= Year[now]) and (Year[now] <= 9998{年}) ;
{ 2~9998年に深い意味はありません }
repeat { 表示したい月を入力 }
write('何月?(1月~12月) ') ;
readln(Month[now])
until Month[now] in [1{月}..12{月}] ;
if Uruu(Year[now]) then Nissu[2{月}] := 29{日} ; { 閏年補正 }
{ 表示する年、月を求める }
Month[before] := Month[now] - 1{月} ;
Month[after ] := Month[now] + 1{月} ;
Year [before] := Year [now] ;
Year [after ] := Year [now] ;
if Month[now] = 1{月} then { 今月が1月の時は、}
begin { 前月は去年の12月 }
Month[before] := 12{月} ;
Year [before] := Year[now] - 1{年}
end
else if Month[now] = 12{月} then { 今月が12月の時は、}
begin { 来月は来年の1月 }
Month[after] := 1{月} ;
Year [after] := Year[now] + 1{年}
end ;
{ 1日の曜日を求める }
FirstYoubi[before] := Youbi(Year[before], Month[before], 1{日}) ;
FirstYoubi[now ] := Youbi(Year[now ], Month[now ], 1{日}) ;
FirstYoubi[after ] := Youbi(Year[after ], Month[after ], 1{日}) ;
Print { 表示する }
end {main}.